home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
tab100
/
board.frm
< prev
next >
Wrap
Text File
|
1995-10-23
|
7KB
|
269 lines
VERSION 2.00
Begin Form Form1
BackColor = &H0000C000&
Caption = "Cards"
ClientHeight = 4605
ClientLeft = 855
ClientTop = 1785
ClientWidth = 7875
Height = 5295
Icon = BOARD.FRX:0000
Left = 795
LinkMode = 1 'Source
LinkTopic = "Form1"
ScaleHeight = 4605
ScaleWidth = 7875
Top = 1155
Width = 7995
Begin TextBox Bet
BackColor = &H0000FFFF&
ForeColor = &H00C00000&
Height = 375
Left = 3120
TabIndex = 6
Top = 3600
Width = 1575
End
Begin CommandButton Deal
Caption = "Deal"
Height = 495
Left = 1680
TabIndex = 0
Top = 3480
Width = 975
End
Begin CommandButton TurnCard
Caption = "Turn Card"
Height = 1455
Left = 3120
TabIndex = 5
Top = 1920
Width = 1575
End
Begin PictureBox Picture1
AutoSize = -1 'True
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
DragMode = 1 'Automatic
Height = 1455
Index = 3
Left = 1680
ScaleHeight = 1455
ScaleWidth = 1095
TabIndex = 4
Top = 1920
Width = 1095
End
Begin PictureBox Picture1
AutoSize = -1 'True
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
DragMode = 1 'Automatic
Height = 1455
Index = 2
Left = 3120
ScaleHeight = 1455
ScaleWidth = 1095
TabIndex = 3
Top = 120
Width = 1095
End
Begin PictureBox Picture1
AutoSize = -1 'True
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
DragMode = 1 'Automatic
Height = 1455
Index = 1
Left = 1680
ScaleHeight = 1455
ScaleWidth = 1095
TabIndex = 2
Top = 120
Width = 1095
End
Begin PictureBox Picture1
AutoSize = -1 'True
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
DragMode = 1 'Automatic
Height = 1455
Index = 0
Left = 240
ScaleHeight = 1455
ScaleWidth = 1095
TabIndex = 1
Top = 120
Width = 1095
End
Begin Label Pot
BackColor = &H0000FFFF&
BorderStyle = 1 'Fixed Single
ForeColor = &H000000FF&
Height = 255
Left = 5400
TabIndex = 7
Top = 600
Width = 1455
End
Begin Label Label1
BackColor = &H0000FFFF&
BorderStyle = 1 'Fixed Single
Caption = "Pot ($)"
ForeColor = &H000000FF&
Height = 255
Left = 4680
TabIndex = 8
Top = 600
Width = 735
End
Begin Menu File
Caption = "&File"
Begin Menu FileNew
Caption = "&New Game"
Shortcut = {F2}
End
Begin Menu FileExit
Caption = "E&xit"
End
End
Begin Menu Help
Caption = "Help"
Begin Menu HelpAbout
Caption = "&About"
End
End
End
DefInt A-Z
Dim CardNo As Integer
Sub CheckForWin (Flag As Integer)
Dim C1 As Integer
Dim C2 As Integer
Flag = False
For i = 0 To 2
If SameSuit(Cards(Val(Picture1(i).Tag)), Cards(Val(Picture1(3).Tag))) Then
C1 = CardValue(Cards(Val(Picture1(i).Tag)))
C2 = CardValue(Cards(Val(Picture1(3).Tag)))
If C2 > C1 Then
Flag = True
Exit Sub
End If
End If
Next i
End Sub
Sub Deal_Click ()
For i = 0 To 2
If CardNo > 52 Then
ShuffleCards
CardNo = 1
End If
GetCard (Cards(CardNo))
Picture1(i).Picture = ClipBoard.GetData(2)
Picture1(i).Tag = Str$(CardNo)
CardNo = CardNo + 1
Next i
GetCardBack (1)
Picture1(3).Picture = ClipBoard.GetData(2)
Picture1(3).Tag = Str$(CardNo)
CardNo = CardNo + 1
End Sub
Sub FileExit_Click ()
End
End Sub
Sub FileNew_Click ()
ShuffleCards
CardNo = 1
Pot.Caption = "100"
Bet.Text = "0"
Deal_Click
End Sub
Sub Form_Load ()
FileNew_Click
Num = 1
End Sub
Sub HelpAbout_Click ()
' Form3.Show 1
End Sub
Sub TurnCard_Click ()
Dim i As Integer
Dim Win As Integer
Dim NumPot As Double
Dim NumBet As Double
NumPot = Val(Pot.Caption)
NumBet = Val(Bet.Text)
If NumBet = 0 Then
MsgBox ("Cannot turn card without a bet")
Exit Sub
End If
If NumBet > NumPot Then
MsgBox ("You cannot bet more than you have")
Exit Sub
End If
i = Val(Picture1(3).Tag)
GetCard (Cards(i))
Picture1(3).Picture = ClipBoard.GetData(2)
CheckForWin Win
If Win = True Then
NumPot = NumPot + (NumBet * 2)
NumBet = 0
MsgBox ("You Win -- This Time")
Else
NumPot = NumPot - NumBet
NumBet = 0
MsgBox ("Lost Again Sucker")
End If
If NumPot = 0 Then
MsgBoxResponse = MsgBox("Sorry You have lost your shirt, Do you wish to Play again (Yes/No)", 19)
If MsgBoxResponse = 7 Then
FileNew_Click
Exit Sub
Else
FileExit_Click
Exit Sub
End If
End If
If NumPot > 1000000 Then
MsgBoxResponse = MsgBox("The house has taken all your money, and thrown you out -- GoodBye")
FileExit_Click
Exit Sub
End If
Pot.Caption = Str$(NumPot)
Bet.Text = "0"
Deal_Click
End Sub